home *** CD-ROM | disk | FTP | other *** search
/ Ham Radio 2000 / Ham Radio 2000.iso / ham2000 / misc / dspice0s / trunc.c < prev    next >
C/C++ Source or Header  |  1992-11-21  |  7KB  |  264 lines
  1. /* trunc.f -- translated by f2c (version of 3 February 1990  3:36:42).
  2.    You must link the resulting object file with the libraries:
  3.     -lF77 -lI77 -lm -lc   (in that order)
  4. */
  5.  
  6. #include "f2c.h"
  7.  
  8. /* Common Block Declarations */
  9.  
  10. struct {
  11.     integer locate[50], jelcnt[50], nunods, ncnods, numnod, nstop, nut, nlt, 
  12.         nxtrm, ndist, ntlin, ibr, numvs, numalt, numcyc;
  13. } cirdat_;
  14.  
  15. #define cirdat_1 cirdat_
  16.  
  17. struct {
  18.     doublereal omega, time, delta, delold[7], ag[7], vt, xni, egfet, xmu, 
  19.         sfactr;
  20.     integer mode, modedc, icalc, initf, method, iord, maxord, noncon, iterno, 
  21.         itemno, nosolv, modac, ipiv, ivmflg, ipostp, iscrch, iofile;
  22. } status_;
  23.  
  24. #define status_1 status_
  25.  
  26. struct {
  27.     integer iprnta, iprntl, iprntm, iprntn, iprnto, limtim, limpts, lvlcod, 
  28.         lvltim, itl1, itl2, itl3, itl4, itl5, itl6, igoof, nogo, keof;
  29. } flags_;
  30.  
  31. #define flags_1 flags_
  32.  
  33. struct {
  34.     doublereal tstep, tstop, tstart, delmax, tdmax, forfre;
  35.     integer jtrflg;
  36. } tran_;
  37.  
  38. #define tran_1 tran_
  39.  
  40. struct {
  41.     doublereal value[200000];
  42. } blank_;
  43.  
  44. #define blank_1 blank_
  45.  
  46. /*<       subroutine trunc(delnew) >*/
  47. /* Subroutine */ int trunc_(delnew)
  48. doublereal *delnew;
  49. {
  50.     /* System generated locals */
  51.     integer i_1;
  52.     doublereal d_1;
  53.  
  54.     /* Local variables */
  55.     static integer loct;
  56.     extern /* Subroutine */ int terr_();
  57. #define nodplc ((integer *)&blank_1)
  58. #define cvalue ((complex *)&blank_1)
  59.     static integer loc;
  60.  
  61. /*<       implicit double precision (a-h,o-z) >*/
  62.  
  63. /*     this routine determines the new transient stepsize by either */
  64. /* calling terr to estimate the local truncation error, or by checking */
  65. /* on the number of iterations needed to converge at the last timepoint. 
  66. */
  67.  
  68. /* spice version 2g.6  sccsid=cirdat 3/15/83 */
  69. /*<       common /cirdat/ locate(50),jelcnt(50),nunods,ncnods,numnod,nstop, >*/
  70. /*<      1   nut,nlt,nxtrm,ndist,ntlin,ibr,numvs,numalt,numcyc >*/
  71. /* spice version 2g.6  sccsid=status 3/15/83 */
  72. /*<       common /status/ omega,time,delta,delold(7),ag(7),vt,xni,egfet, >*/
  73. /*<      1   xmu,sfactr,mode,modedc,icalc,initf,method,iord,maxord,noncon, >*/
  74. /*<      2   iterno,itemno,nosolv,modac,ipiv,ivmflg,ipostp,iscrch,iofile >*/
  75. /* spice version 2g.6  sccsid=flags 3/15/83 */
  76. /*<       common /flags/ iprnta,iprntl,iprntm,iprntn,iprnto,limtim,limpts, >*/
  77. /*<      1   lvlcod,lvltim,itl1,itl2,itl3,itl4,itl5,itl6,igoof,nogo,keof >*/
  78. /* spice version 2g.6  sccsid=tran 3/15/83 */
  79. /*<       common /tran/ tstep,tstop,tstart,delmax,tdmax,forfre,jtrflg >*/
  80. /* spice version 2g.6  sccsid=blank 3/15/83 */
  81. /*<       common /blank/ value(200000) >*/
  82. /*<       integer nodplc(64) >*/
  83. /*<       complex cvalue(32) >*/
  84. /*<       equivalence (value(1),nodplc(1),cvalue(1)) >*/
  85.  
  86.  
  87. /*<       if (lvltim.ne.0) go to 5 >*/
  88.     if (flags_1.lvltim != 0) {
  89.     goto L5;
  90.     }
  91. /*<       delnew=dmin1(tstep,delmax) >*/
  92.     *delnew = min(tran_1.tstep,tran_1.delmax);
  93. /*<       return >*/
  94.     return 0;
  95. /*<     5 if (lvltim.ne.1) go to 10 >*/
  96. L5:
  97.     if (flags_1.lvltim != 1) {
  98.     goto L10;
  99.     }
  100. /*<       delnew=delta >*/
  101.     *delnew = status_1.delta;
  102. /*<       if (iterno.gt.itl3) return >*/
  103.     if (status_1.iterno > flags_1.itl3) {
  104.     return 0;
  105.     }
  106. /*<       delnew=dmin1(2.0d0*delta,tstep,delmax) >*/
  107. /* Computing MAX */
  108.     d_1 = status_1.delta * 2., d_1 = min(tran_1.tstep,d_1);
  109.     *delnew = min(tran_1.delmax,d_1);
  110. /*<       return >*/
  111.     return 0;
  112.  
  113. /*  capacitors */
  114.  
  115. /*<    10 delnew=1.0d20 >*/
  116. L10:
  117.     *delnew = 1e20;
  118. /*<       loc=locate(2) >*/
  119.     loc = cirdat_1.locate[1];
  120. /*<    20 if ((loc.eq.0).or.(nodplc(loc+12).ne.0)) go to 30 >*/
  121. L20:
  122.     if (loc == 0 || nodplc[loc + 11] != 0) {
  123.     goto L30;
  124.     }
  125. /*<       loct=nodplc(loc+8) >*/
  126.     loct = nodplc[loc + 7];
  127. /*<       call terr(loct,delnew) >*/
  128.     terr_(&loct, delnew);
  129. /*<       loc=nodplc(loc) >*/
  130.     loc = nodplc[loc - 1];
  131. /*<       go to 20 >*/
  132.     goto L20;
  133.  
  134. /*  inductors */
  135.  
  136. /*<    30 loc=locate(3) >*/
  137. L30:
  138.     loc = cirdat_1.locate[2];
  139. /*<    40 if ((loc.eq.0).or.(nodplc(loc+14).ne.0)) go to 50 >*/
  140. L40:
  141.     if (loc == 0 || nodplc[loc + 13] != 0) {
  142.     goto L50;
  143.     }
  144. /*<       loct=nodplc(loc+11) >*/
  145.     loct = nodplc[loc + 10];
  146. /*<       call terr(loct,delnew) >*/
  147.     terr_(&loct, delnew);
  148. /*<       loc=nodplc(loc) >*/
  149.     loc = nodplc[loc - 1];
  150. /*<       go to 40 >*/
  151.     goto L40;
  152.  
  153. /*  diodes */
  154.  
  155. /*<    50 loc=locate(11) >*/
  156. L50:
  157.     loc = cirdat_1.locate[10];
  158. /*<    60 if ((loc.eq.0).or.(nodplc(loc+16).ne.0)) go to 70 >*/
  159. L60:
  160.     if (loc == 0 || nodplc[loc + 15] != 0) {
  161.     goto L70;
  162.     }
  163. /*<       loct=nodplc(loc+11) >*/
  164.     loct = nodplc[loc + 10];
  165. /*<       call terr(loct+3,delnew) >*/
  166.     i_1 = loct + 3;
  167.     terr_(&i_1, delnew);
  168. /*<       loc=nodplc(loc) >*/
  169.     loc = nodplc[loc - 1];
  170. /*<       go to 60 >*/
  171.     goto L60;
  172.  
  173. /*  bjts */
  174.  
  175. /*<    70 loc=locate(12) >*/
  176. L70:
  177.     loc = cirdat_1.locate[11];
  178. /*<    80 if ((loc.eq.0).or.(nodplc(loc+36).ne.0)) go to 90 >*/
  179. L80:
  180.     if (loc == 0 || nodplc[loc + 35] != 0) {
  181.     goto L90;
  182.     }
  183. /*<       loct=nodplc(loc+22) >*/
  184.     loct = nodplc[loc + 21];
  185. /*<       call terr(loct+8,delnew) >*/
  186.     i_1 = loct + 8;
  187.     terr_(&i_1, delnew);
  188. /*<       call terr(loct+10,delnew) >*/
  189.     i_1 = loct + 10;
  190.     terr_(&i_1, delnew);
  191. /*<       call terr(loct+12,delnew) >*/
  192.     i_1 = loct + 12;
  193.     terr_(&i_1, delnew);
  194. /*<       loc=nodplc(loc) >*/
  195.     loc = nodplc[loc - 1];
  196. /*<       go to 80 >*/
  197.     goto L80;
  198.  
  199. /*  jfets */
  200.  
  201. /*<    90 loc=locate(13) >*/
  202. L90:
  203.     loc = cirdat_1.locate[12];
  204. /*<   100 if ((loc.eq.0).or.(nodplc(loc+25).ne.0)) go to 110 >*/
  205. L100:
  206.     if (loc == 0 || nodplc[loc + 24] != 0) {
  207.     goto L110;
  208.     }
  209. /*<       loct=nodplc(loc+19) >*/
  210.     loct = nodplc[loc + 18];
  211. /*<       call terr(loct+9,delnew) >*/
  212.     i_1 = loct + 9;
  213.     terr_(&i_1, delnew);
  214. /*<       call terr(loct+11,delnew) >*/
  215.     i_1 = loct + 11;
  216.     terr_(&i_1, delnew);
  217. /*<       loc=nodplc(loc) >*/
  218.     loc = nodplc[loc - 1];
  219. /*<       go to 100 >*/
  220.     goto L100;
  221.  
  222. /*  mosfets */
  223.  
  224. /*<   110 loc=locate(14) >*/
  225. L110:
  226.     loc = cirdat_1.locate[13];
  227. /*<   120 if ((loc.eq.0).or.(nodplc(loc+33).ne.0)) go to 200 >*/
  228. L120:
  229.     if (loc == 0 || nodplc[loc + 32] != 0) {
  230.     goto L200;
  231.     }
  232. /*<       loct=nodplc(loc+26) >*/
  233.     loct = nodplc[loc + 25];
  234. /*<       call terr(loct+12,delnew) >*/
  235.     i_1 = loct + 12;
  236.     terr_(&i_1, delnew);
  237. /*<       call terr(loct+14,delnew) >*/
  238.     i_1 = loct + 14;
  239.     terr_(&i_1, delnew);
  240. /*<       call terr(loct+16,delnew) >*/
  241.     i_1 = loct + 16;
  242.     terr_(&i_1, delnew);
  243. /*<       loc=nodplc(loc) >*/
  244.     loc = nodplc[loc - 1];
  245. /*<       go to 120 >*/
  246.     goto L120;
  247.  
  248. /*  delta is allowed only to double at each timepoint */
  249.  
  250. /*<   200 delnew=dmin1(2.0d0*delta,delnew,delmax) >*/
  251. L200:
  252. /* Computing MAX */
  253.     d_1 = status_1.delta * 2., d_1 = min(*delnew,d_1);
  254.     *delnew = min(tran_1.delmax,d_1);
  255. /*<       return >*/
  256.     return 0;
  257. /*<       end >*/
  258. } /* trunc_ */
  259.  
  260. #undef cvalue
  261. #undef nodplc
  262.  
  263.  
  264.